      subroutine Mstarta(filename)
      implicit real*8 (a-h,o-z)
      character*40 fname,filename(20)
      common /aa/ ia(256000000)
      common /bb/ ib(128000000)
      common /cc/ ic(64000000)
      maxt=256000000
      open(1,file=filename(1),form='unformatted',status='old')
      read(1) knode,kdgof
      close(1)
      kvar=knode*kdgof
      kvar1=kvar+1
c      write(*,*) 'knode,kdgof,kvar ='
c      write(*,'(1x,4i7)') knode,kdgof,kvar
      KCOOR=3
        KELEM=32000000
 
      knb1=kdgof*knode*1
      if (knb1/2*2 .lt. knb1) knb1=knb1+1
      kna1=kcoor*knode*2
      kna2=kdgof*knode*2
      kna3=kdgof*knode*2
      kna4=kdgof*knode*2
      knb4=1000*1
      if (knb4/2*2 .lt. knb4) knb4=knb4+1
      knc2=kelem*1
      if (knc2/2*2 .lt. knc2) knc2=knc2+1
      knb2=kvar1*1
      if (knb2/2*2 .lt. knb2) knb2=knb2+1
      knb3=kvar1*1
      if (knb3/2*2 .lt. knb3) knb3=knb3+1
      knd1=maxt*1
      if (knd1/2*2 .lt. knd1) knd1=knd1+1
      knc1=kvar1*1
      if (knc1/2*2 .lt. knc1) knc1=knc1+1
      kna0=1
      kna1=kna1+kna0
      kna2=kna2+kna1
      kna3=kna3+kna2
      kna4=kna4+kna3
      if (kna4-1.gt.256000000) then
      write(*,*) 'exceed memory of array ia'
      write(*,*) 'memory of ia = 256000000'
      write(*,*) 'memory needed = ',kna4,' in prgram start'
      stop 55555
      endif
      knb0=1
      knb1=knb1+knb0
      knb2=knb2+knb1
      knb3=knb3+knb2
      knb4=knb4+knb3
      if (knb4-1.gt.64000000) then
      write(*,*) 'exceed memory of array ic'
      write(*,*) 'memory of ic = 64000000'
      write(*,*) 'memory needed = ',knb4,' in prgram start'
      stop 55555
      endif
      knc0=1
      knc1=knc1+knc0
      knc2=knc2+knc1
      if (knc2-1.gt.128000000) then
      write(*,*) 'exceed memory of array ib'
      write(*,*) 'memory of ib = 128000000'
      write(*,*) 'memory needed = ',knc2,' in prgram start'
      stop 55555
      endif
      knd0=1
      knd1=knd1+knd0
      if (knd1-1.gt.256000000) then
      write(*,*) 'exceed memory of array ia'
      write(*,*) 'memory of ia = 256000000'
      write(*,*) 'memory needed = ',knd1,' in prgram start'
      stop 55555
      endif
      call starta_1(knode,kdgof,kcoor,kvar,
     *kelem,maxt,kvar1,ia(kna0),ia(kna1),ia(kna2),
     *ia(kna3),ic(knb0),ic(knb1),ic(knb2),ic(knb3),
     *ib(knc0),ib(knc1),ia(knd0),
     *filename)
      return
      end
      subroutine starta_1(knode,kdgof,kcoor,kvar,
     *kelem,maxt,kvar1,coor,u0,u1,
     *u2,nodvar,jnz,numcol,lm,jdiag,
     *node,na,
     *filename)
      use mtxData
      implicit real*8 (a-h,o-z)
      character*40 filename(20)
      DIMENSION  NODVAR(KDGOF,KNODE),COOR(KCOOR,KNODE),R(3),
     &  U0(KDGOF,KNODE),U1(KDGOF,KNODE),U2(KDGOF,KNODE),
     &  LM(1000),NODE(KELEM),
     &  jnz(kvar1),numcol(kvar1),na(maxt),jdiag(kvar1)
      CHARACTER*1 MATERIAL
        logical filflg
 
6       FORMAT (1X, 15I5)
7       FORMAT (1X,6F13.4)
C.......OPEN ID file
      OPEN (1,FILE=filename(2),FORM='UNFORMATTED',STATUS='OLD')
      READ (1) NUMNOD,NODDOF,((NODVAR(I,J),I=1,NODDOF),J=1,NUMNOD)
      CLOSE (1)
      call starta_6(kdgof,knode,NODVAR)
c      WRITE(*,*) 'NUMNOD =',NUMNOD,' NODDOF =',NODDOF
c      WRITE (*,*) 'ID ='
c      WRITE (*,6) ((NODVAR(I,J),I=1,NODDOF),J=1,NUMNOD)
      NEQ=0
      DO 20 J=1,NUMNOD
      DO 18 I=1,NODDOF
      IF (NODVAR(I,J).NE.1) GOTO 18
      NEQ = NEQ + 1
      NODVAR(I,J) = NEQ
18      CONTINUE
20      CONTINUE
      DO 30 J=1,NUMNOD
      DO 28 I=1,NODDOF
      IF (NODVAR(I,J).GE.-1) GOTO 28
      N = -NODVAR(I,J)-1
      NODVAR(I,J) = NODVAR(I,N)
28      CONTINUE
30      CONTINUE
      OPEN(8,FILE=filename(3),STATUS='unknown',FORM='UNFORMATTED')
      WRITE(8) ((NODVAR(I,J),I=1,NODDOF),J=1,NUMNOD)
      CLOSE(8)
c      WRITE(*,*) 'NUMNOD =',NUMNOD,'  NODDOF =',NODDOF
c      WRITE(*,6) ((NODVAR(I,J),I=1,NODDOF),J=1,NUMNOD)
      MAXCOL=MAXT/NEQ
 
C....OPEN DISP FILE
      OPEN(1,FILE=filename(4),FORM='UNFORMATTED',STATUS='OLD')
      READ(1) NUMNOD,NODDOF,((U0(I,J),I=1,NODDOF),J=1,NUMNOD)
      CLOSE(1)
C....OPEN DISP FILE
      OPEN(1,FILE=filename(5),FORM='UNFORMATTED',STATUS='unknown')
      WRITE(1) ((U0(I,J),I=1,NODDOF),J=1,NUMNOD),
     *          ((0.0,I=1,NODDOF),J=1,NUMNOD)
      CLOSE(1)
 
C.......OPEN TIME0 File
      OPEN(1,FILE=filename(6),FORM='FORMATTED')
      READ(1,*) T0,TMAX,DT
      TIME = T0
      IT = 0
c      WRITE(*,*) ' TMAX,DT,TIME,IT =',TMAX,DT,TIME,IT
      CLOSE(1)
 
C.......OPEN TIME File
      OPEN(1,FILE=filename(7),FORM='UNFORMATTED',STATUS='unknown')
      WRITE(1) TMAX,DT,TIME,IT
      CLOSE(1)
 
C.......OPEN COOR file
      OPEN (1,FILE=filename(8),FORM='UNFORMATTED',STATUS='OLD')
      READ (1) NUMNOD,NCOOR,((COOR(I,J),I=1,NCOOR),J=1,NUMNOD)
      CLOSE(1)
C        WRITE(*,*) 'COOR ='
C        WRITE(*,7) ((COOR(I,J),I=1,NCOOR),J=1,NUMNOD)
 
        zo = 0.0d0
c        DO 321 N=1,NUMNOD
c      DO 100 J=1,NCOOR
c100   R(J) = COOR(J,N)
c      DO 200 J=1,NODDOF
c        U0(J,N) = BOUND(R,zo,J)
c        U1(J,N) = BOUND1(R,zo,J)
c        U2(J,N) = BOUND2(R,zo,J)
c200   CONTINUE
c321   CONTINUE
      inquire(file='disp1',exist=filflg)
      if (filflg) then
      open(16,file='disp1',form='unformatted',status='old')
      read(16) numnod,noddof,((U0(J,N),J=1,NODDOF),N=1,NUMNOD)
      close(16)
      endif
      inquire(file='disp2',exist=filflg)
      if (filflg) then
      open(16,file='disp2',form='unformatted',status='old')
      read(16) numnod,noddof,((U1(J,N),J=1,NODDOF),N=1,NUMNOD)
      close(16)
      endif
      inquire(file='disp3',exist=filflg)
      if (filflg) then
      open(16,file='disp3',form='unformatted',status='old')
      read(16) numnod,noddof,((U2(J,N),J=1,NODDOF),N=1,NUMNOD)
      close(16)
      endif
c      WRITE(*,*) ' U0 = '
c      WRITE(*,'(6F13.3)') ((U0(J,N),J=1,NODDOF),N=1,NUMNOD)
C       WRITE(*,*) ' U1 = '
C       WRITE(*,'(6F13.3)') ((U1(J,N),J=1,NODDOF),N=1,NUMNOD)
 
C.......OPEN U0 file
      OPEN (1,FILE=filename(9),FORM='UNFORMATTED',STATUS='unknown')
      WRITE(1) ((U0(I,J),J=1,NUMNOD),I=1,NODDOF),
     *  ((U1(I,J),J=1,NUMNOD),I=1,NODDOF),
     *  ((U2(I,J),J=1,NUMNOD),I=1,NODDOF),
     *  ((U0(I,J),J=1,NUMNOD),I=1,NODDOF)
      CLOSE (1)
 
      DO 350 I=1,NEQ
        numcol(i)=0
        jnz(i)=0
350     CONTINUE
 
C ..... OPEN IO FILE
      OPEN(1,FILE=filename(10),FORM='FORMATTED',STATUS='OLD')
      READ(1,'(1a)') MATERIAL
      READ(1,*) NUMTYP
      CLOSE (1)
 
C.......OPEN ELEM0 file
      OPEN (3,FILE=filename(11),FORM='UNFORMATTED',STATUS='OLD')
 
      do jj=1,2
      NUMEL=0
      KELEM=0
      KEMATE=0
      DO 2000 ITYP=1,NUMTYP
C.......INPUT ENODE
      READ (3) NUM,NNODE,
     *           ((NODE((I-1)*NNODE+J),J=1,NNODE),I=1,NUM)
cc      WRITE(*,*) 'NUM =',NUM,' NNODE =',NNODE
cc      WRITE(*,*) 'NODE ='
cc      WRITE(*,6) ((NODE((I-1)*NNODE+J),J=1,NNODE),I=1,NUM)
      IF (KELEM.LT.NUM*NNODE) KELEM = NUM*NNODE
      NNE = NNODE
      IF (MATERIAL.EQ.'Y' .OR. MATERIAL.EQ.'y') THEN
       READ (3) MMATE,NMATE
       IF (KEMATE.LT.MMATE*NMATE) KEMATE = MMATE*NMATE
       NNE = NNE-1
      ENDIF
c      WRITE(*,*) 'MMATE =',MMATE,' NMATE =',NMATE
cc    WRITE(*,*) 'NUM =',NUM,' NNODE =',NNODE
cc    WRITE(*,*) 'NODE ='
cc    WRITE(*,6) ((NODE((I-1)*NNODE+J),J=1,NNODE),I=1,NUM)
      DO 1000 NE=1,NUM
      L=0
      DO 700 INOD=1,NNE
      NODI=NODE((NE-1)*NNODE+INOD)
      DO 600 IDGF=1,KDGOF
      INV=NODVAR(IDGF,NODI)
      IF (INV.LE.0) GOTO 600
      L=L+1
      LM(L)=INV
600     CONTINUE
700     CONTINUE
      NUMEL=NUMEL+1
C      WRITE (*,*) 'L,LM =',L
C      WRITE (*,'(1X,15I5)') (LM(I),I=1,L)
        if (jj.eq.1) then
        if (l.gt.0) call starta_2(L,jnz,lm)
        else
        if (l.gt.0) call starta_3(NEQ,jnz,NUMCOL,NA,l,lm,MAXT)
        endif
1000  continue
2000  CONTINUE
        if (jj.eq.1) then
        DO 800 N=1,NEQ-1
800     jnz(N+1) = jnz(N+1)+jnz(N)
      DO 850 N=1,NEQ
850     jnz(NEQ-N+2) = jnz(NEQ-N+1)
        jnz(1) = 0
        IF (JNZ(NEQ+1).GT.MAXT) THEN
        WRITE(*,*) 'EXCEET CORE MEMORY ....',JNZ(NEQ+1),' > ',MAXT
        STOP 1111
        ENDIF
      rewind(3)
        endif
      enddo
      CLOSE(3)
 
      call starta_5(NEQ,jnz,NUMCOL,NA,jdiag,LM,MAXT)
      MAXA=NUMCOL(NEQ+1)
 
C.......OPEN SYS File
      OPEN (2,FILE=filename(12),FORM='UNFORMATTED',STATUS='unknown')
      WRITE(2) NUMEL,NEQ,NUMTYP,MAXA,KELEM,KEMATE
      CLOSE (2)
 
      OPEN(2,FILE=filename(13),FORM='UNFORMATTED',STATUS='unknown')
      write(2) (numcol(I),I=1,NEQ+1)
      write(2) (na(I),I=1,MAXA)
      write(2) (jdiag(i),i=1,neq)
      CLOSE(2)
 
C        write(*,*) 'NEQ,numcol,na=',NEQ
C        write(*,6) (numcol(I),I=1,NEQ+1)
C        write(*,6) (na(i),i=1,MAXA)
C==============================================================C
C     Copy data numcol,na to Module
C==============================================================C
      neq_m = neq
      maxa_m = maxa
      call malloc_mat_data
      do i=1,neq+1
        numcol_m(i) = numcol(i)
      enddo
      do i=1,maxa
        na_m(i) = na(i)
      enddo
C==============================================================C

      RETURN
      END
 
        SUBROUTINE starta_2(ND,NUMCOL,LM)
      implicit real*8 (a-h,o-z)
        DIMENSION NUMCOL(*),LM(*)
6       FORMAT(1X,10I7)
C       WRITE (*,*) 'ND= ',ND, (LM(I),I=1,ND)
      DO 400 I=1,ND
      NI = LM(I)
      DO 300 J=1,ND
      NJ = LM(J)
cc        IF (NJ.EQ.NI) GOTO 300
        NUMCOL(NI) = NUMCOL(NI)+1
300     CONTINUE
400     CONTINUE
C       WRITE(*,*) 'NUMCOL ='
C       WRITE(*,6) (NUMCOL(N),N=1,NEQ)
1000    RETURN
      END
 
        SUBROUTINE starta_3(NEQ,JNZ,NUMCOL,MHT,ND,LM,MAXT)
      implicit real*8 (a-h,o-z)
        DIMENSION MHT(MAXT),JNZ(*),NUMCOL(*),LM(*)
6       FORMAT(1X,10I7)
C       WRITE (*,*) 'ND= ',ND, (LM(I),I=1,ND)
      DO 400 I=1,ND
      NI = LM(I)
      DO 300 J=1,ND
C       IF (J.EQ.I) GOTO 300
      NJ = LM(J)
      DO 200 K=1,NUMCOL(NI)
        IF (NJ.EQ.MHT(K+JNZ(NI))) GOTO 300
200     CONTINUE
      NUMCOL(NI) = NUMCOL(NI)+1
        IF (NI.GT.NEQ) THEN
        WRITE(*,*) 'NI ====',NI
        STOP 1234
        ENDIF
        MHT(NUMCOL(NI)+JNZ(NI)) = NJ
300     CONTINUE
400     CONTINUE
C       WRITE(*,*) 'NUMCOL ='
C       WRITE(*,6) (NUMCOL(N),N=1,NEQ)
C       WRITE(*,*) 'MHT ='
C       DO 2000 N=1,NEQ
C2000   WRITE(*,6) (MHT(I+JNZ(N)),I=1,NUMCOL(N))
1000    RETURN
      END
 
      SUBROUTINE starta_4(ND,LM)
      implicit real*8 (a-h,o-z)
        DIMENSION LM(*)
C       WRITE(*,*) '**** ORDER ****'
C       WRITE(*,*) (LM(I),I=1,ND)
      DO 200 I=1,ND
      LS=LM(I)+1
      DO 100 J=I,ND
      IF (LM(J).GT.LS) GOTO 100
      LS=LM(J)
      J0=J
100     CONTINUE
      LM(J0)=LM(I)
      LM(I)=LS
200     CONTINUE
C       WRITE(*,*) (LM(I),I=1,ND)
C       WRITE(*,*) '-----------------'
      RETURN
      END
 
        SUBROUTINE starta_5(NEQ,JNZ,NUMCOL,NA,jdiag,LMI,MAXT)
      implicit real*8 (a-h,o-z)
        DIMENSION JNZ(*),NUMCOL(*),NA(*),jdiag(neq),LMI(*)
      DO 600 N=1,NEQ
CC        NN = (N-1)*MAXCOL
        NN=JNZ(N)
      LI = NUMCOL(N)
      DO 500 I=1,LI
500     LMI(I) = NA(NN+I)
      CALL starta_4(LI,LMI)
      DO 550 I=1,LI
550     NA(NN+I) = LMI(I)
600     CONTINUE
 
      NSUM = 0
      DO 700 N=1,NEQ
CC        NN=(N-1)*MAXCOL
        NN=JNZ(N)
      DO 700 I=1,NUMCOL(N)
      NSUM = NSUM+1
      NA(NSUM) = NA(NN+I)
700     CONTINUE
      DO 800 N=1,NEQ-1
800     NUMCOL(N+1) = NUMCOL(N+1)+NUMCOL(N)
      DO 850 N=1,NEQ
850     NUMCOL(NEQ-N+2) = NUMCOL(NEQ-N+1)
      NUMCOL(1) = 0
C       WRITE(*,*) 'NSUM,NUMCOL(NEQ+1) =',NSUM,NUMCOL(NEQ+1)
C       WRITE(*,*) 'NUMCOL ='
C       WRITE(*,6) (NUMCOL(N),N=1,NEQ+1)
C       WRITE(*,*) 'NA ='
C       WRITE(*,6) (NA(I),I=1,NSUM)
      do 1400 ir=1, neq-1
        nir0 = numcol(ir)+1
        nir1 = numcol(ir+1)
      do 1380 id=nir0,nir1
      if(na(id).eq.ir) then
      jdiag(ir)=id
      goto 1381
      endif
1380    continue
1381    continue
1400    continue
      jdiag(neq)=numcol(neq+1)
 
1000    RETURN
6       FORMAT(1X,5I15)
      END
 
      subroutine starta_6(kdgof,knode,id)
      dimension id(kdgof,knode),ms(10000),is(10000)
      do 1000 k=1,kdgof
      m = 0
      do 800 n=1,knode
      if (id(k,n).le.1) goto 800
       j=id(k,n)
       j0=0
       if (m.gt.0) then
        do i=1,m
         if (j.eq.ms(i)) j0=is(i)
        enddo
       endif
       if (j0.eq.0) then
        m=m+1
        ms(m)=j
        is(m)=n
        id(k,n)=1
       else
        id(k,n)=-j0-1
       endif
800   continue
1000  continue
      return
      end
